( resources )

( resource types )
$8001 constant rIcon
$8002 constant rPicture
$8003 constant rControlList
$8004 constant rControlTemplate
$8005 constant rC1InputString
$8006 constant rPString
$8007 constant rStringList
$8008 constant rMenuBar
$8009 constant rMenu
$800a constant rMenuItem
$800b constant rTextForLETextBox2
$800d constant rCtlColorTbl
$800e constant rWindParam1
$800f constant rWindParam2
$8010 constant rWindColor
$8011 constant rTextBlock
$8012 constant rStyleBlock
$8013 constant rToolStartup
$8014 constant rResName
$8015 constant rAlertString
$8016 constant rText
$8018 constant rCDEVCode
$8019 constant rCDEVFlags
$801a constant rTwoRects
$801c constant rListRef
$801d constant rCString
$8020 constant rErrorString
$8021 constant rKTransTable
$8023 constant rC1OutputString
$8025 constant rTERuler

( resource attributes )
$0800 constant resConverter
$0400 constant resAbsLoad
$0080 constant resProtected
$0040 constant resPreLoad
$0020 constant resChanged
\ attrLocked
\ attrFixed
\ attrPurge
\ attrPurge3
\ attrPurge2
\ attrPurge1
\ attrNoPurge
\ attrNoCross
\ attrNoSpec
\ attrPage

( resource file header )
struct
  long%       field ResHeaderRec>rFileVersion
  long%       field ResHeaderRec>rFileToMap
  long%       field ResHeaderRec>rFileMapSize
  byte% $80 * field ResHeaderRec>rFileMemo
end-struct ResHeaderRec%

( resource map )
struct
  long% field MapRec>mapNext
  word% field MapRec>mapFlag
  long% field MapRec>mapOffset
  long% field MapRec>mapSize
  word% field MapRec>mapToIndex
  word% field MapRec>mapFileNum
  word% field MapRec>mapID
  long% field MapRec>mapIndexSize
  long% field MapRec>mapIndexUsed
  word% field MapRec>mapFreeListSize
  word% field MapRec>mapFreeListUsed
  \ $xxxx field MapRec>mapFreeList
  \ $xxxx field MapRec>mapIndex
end-struct MapRec%

( resource free block )
struct
  long% field FreeBlockRec>blkOffset
  long% field FreeBlockRec>blkSize
end-struct FreeBlockRec%

( resource reference )
struct
  word% field ResRefRec>resType
  long% field ResRefRec>resID
  long% field ResRefRec>resOffset
  word% field ResRefRec>resAttr
  long% field ResRefRec>resSize
  long% field ResRefRec>resHandle
end-struct ResRefRec%

( resource fork segments )
data-segment bank new-segment constant rezdataseg
data-segment bank new-segment constant rezmapseg

( save room for later )

rezdataseg switch-segment

ResHeaderRec% %size var rez.file_header

rezmapseg switch-segment

MapRec%       %size var   rez.map
FreeBlockRec% %size var   rez.free_block
$00000000 t4, \ free block terminator
                    label rez.map_index

( resource creation )

variable #rez 0 #rez !

: start-rez ( attr id type -- ta )
  \ save address of ResRefRec for end-rez
  rezmapseg switch-segment there >r

  t2, \ resType
  t4, \ resID

  rezdataseg switch-segment there ta>offset rezmapseg switch-segment t4, \ resOffset

  t2, \ resAttr
  $00000000 t4, \ resSize
  $00000000 t4, \ resHandle

  rezdataseg switch-segment r> ;

: end-rez ( ta -- )
  rezdataseg switch-segment there ta>offset
  rezmapseg switch-segment
  over ResRefRec>resOffset t4@ -
  swap ResRefRec>resSize t4!
  $1 #rez +! ;

: dummy-rez ( -- )
  rezmapseg switch-segment $0000 t2, ; \ reference record terminator

: fix-rez-file-header ( -- )
  rezdataseg switch-segment
  $00000000 rez.file_header ResHeaderRec>rFileVersion t4!
  there     rez.file_header ResHeaderRec>rFileToMap a4!
  rezmapseg switch-segment there rezdataseg switch-segment rez.file_header ResHeaderRec>rFileMapSize a4! ;

: fix-rez-map ( -- )
  rezdataseg switch-segment there
  rezmapseg switch-segment

  $00000000     rez.map MapRec>mapNext         t4!
  $0000         rez.map MapRec>mapFlag         t2!
                rez.map MapRec>mapOffset       a4!
  there         rez.map MapRec>mapSize         a4!
  rez.map_index rez.map MapRec>mapToIndex      a2!
  $0000         rez.map MapRec>mapFileNum      t2!
  $0000         rez.map MapRec>mapID           t2!
  #rez @        rez.map MapRec>mapIndexSize    t4!
  #rez @        rez.map MapRec>mapIndexUsed    t4!
  $0001         rez.map MapRec>mapFreeListSize t2!
  $0001         rez.map MapRec>mapFreeListUsed t2! ;

: fix-rez-free-block ( -- )
  rezdataseg switch-segment there ta>offset
  rezmapseg switch-segment there ta>offset +
  dup rez.free_block FreeBlockRec>blkOffset t4!
  invert rez.free_block FreeBlockRec>blkSize t4! ;

: ref< ( ref1 ref2 -- f )
  over ResRefRec>resType t2@
  over ResRefRec>resType t2@ = if
    swap ResRefRec>resID t4@
    swap ResRefRec>resID t4@ u<
  else
    swap ResRefRec>resType t2@
    swap ResRefRec>resType t2@ u<
  then ;

: trade-byte ( ta1 ta2 -- )
  over t1@ over t1@ >r
  swap t1! r> swap t1! ;

: trade-bytes ( ta1 ta2 n -- )
  0 do
    2dup trade-byte
    swap $1 + swap $1 +
  loop 2drop ;

: trade-references ( ref1 ref2 -- )
  ResRefRec% %size trade-bytes ;

: rez.map_index[] ( n -- ref )
  ResRefRec% %size *
  rez.map_index + ;

: sort-references ( -- )
  rezmapseg switch-segment
  #rez @ 1- 0 do
    #rez @ i 1+ do
      j rez.map_index[]
      i rez.map_index[]
      2dup ref< if
        2drop
      else
        trade-references
      then
    loop
  loop ;

: write-rez ( ca n -- )
  dummy-rez
  fix-rez-file-header
  fix-rez-map
  fix-rez-free-block
  sort-references

  w/o bin create-file throw
  dup rezdataseg write-segment
  dup rezmapseg write-segment
  close-file throw ;

